home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / obero / oberon_lib.lha / oberon-a / source1.lha / source / Library / Errors.mod < prev    next >
Text File  |  1994-08-08  |  5KB  |  160 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Errors.mod $
  4.   Description: Error handling and reporting
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.6 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:24:53 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE Errors;
  18.  
  19. (*
  20. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N- NilChk
  21. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  22. ** $V= OvflChk       $Z= ZeroVars
  23. *)
  24.  
  25. IMPORT SYS := SYSTEM, E := Exec, IU := IntuiUtil;
  26.  
  27. VAR
  28.   Report * : PROCEDURE (msg1, msg2, msg3 : ARRAY OF CHAR);
  29.   Traps : ARRAY 26 OF E.STRPTR;
  30.  
  31. CONST
  32.   Line1 = "Oberon-A Error Handler";
  33.  
  34.  
  35. (*------------------------------------*)
  36. (*
  37. ** This will be changed in a future release to use Intuition.EasyRequest()
  38. *)
  39. PROCEDURE* DefaultReport (msg1, msg2, msg3 : ARRAY OF CHAR);
  40.  
  41.   VAR bodyText : ARRAY 3 OF E.APTR;
  42.  
  43. (* $D- disable copying of open arrays *)
  44. BEGIN (* DefaultReport *)
  45.   bodyText [0] := SYS.ADR (msg1);
  46.   bodyText [1] := SYS.ADR (msg2);
  47.   bodyText [2] := SYS.ADR (msg3);
  48.   IU.MultiNotice (NIL, bodyText, 3);
  49. END DefaultReport;
  50.  
  51.  
  52. (*------------------------------------*)
  53. (* $D- disable copying of open arrays *)
  54. PROCEDURE Abort * (msg : ARRAY OF CHAR);
  55.  
  56. BEGIN (* Abort *)
  57.   (*
  58.   ** Report must be initialised, but it isn't worth an ASSERT, since we
  59.   ** are exiting anyway.
  60.   *)
  61.   IF Report # NIL THEN Report (Line1, msg, "Program terminating ...") END;
  62.   HALT (20)
  63. END Abort;
  64.  
  65.  
  66. (*------------------------------------*)
  67. (* $D- disable copying of open arrays *)
  68. PROCEDURE Assert * (condition : BOOLEAN; msg : ARRAY OF CHAR);
  69.  
  70. BEGIN (* Assert *)
  71.   IF ~condition THEN Abort (msg) END
  72. END Assert;
  73.  
  74.  
  75. (*------------------------------------*)
  76. (* $S- Stack checking OFF, otherwise this DOESN'T WORK *)
  77. PROCEDURE* PutCh ();
  78.  
  79. BEGIN (* PutCh *)
  80.   SYS.INLINE (16C0H)   (* MOVE.B D0,(A3)+ *)
  81. END PutCh;
  82. (* $S= Stack checking back on *)
  83.  
  84. (* $L- LongVars OFF, for efficiency *)
  85.  
  86. (*------------------------------------*)
  87. PROCEDURE* ReportRC ();
  88.  
  89.   CONST RunTimeError = "Run-time error detected";
  90.  
  91.   VAR
  92.    line3 : E.STRPTR; str : ARRAY 60 OF CHAR; strPtr : E.STRPTR;
  93.    rc : LONGINT;
  94.  
  95. BEGIN (* ReportRC *)
  96.   (*
  97.   ** Report must be initialised, but it isn't worth an ASSERT, since we
  98.   ** are exiting anyway.
  99.   *)
  100.   IF Report # NIL THEN
  101.     rc := SYS.RC ();
  102.     IF ((rc >= 102) & (rc <= 111)) OR ((rc >= 132) & (rc <= 147)) THEN
  103.       IF rc <= 111 THEN
  104.         line3 := Traps [rc - 102]
  105.       ELSE
  106.         line3 := Traps [rc - 122]
  107.       END; (* ELSE *)
  108.       Report (Line1, "Processor trap detected", line3^)
  109.     ELSIF rc = 21 THEN
  110.       Report (Line1, RunTimeError, "Failed to open mathffp.library")
  111.     ELSIF rc = 22 THEN
  112.       Report (Line1, RunTimeError, "Freeing unallocated memory")
  113.     ELSIF rc = 23 THEN
  114.       Report (Line1, RunTimeError, "Divide by zero")
  115.     ELSIF rc = 30 THEN
  116.       Report (Line1, RunTimeError, "String conversion: ~(2 <= base <= 16)")
  117.     ELSIF rc = 99 THEN
  118.       Report (Line1, RunTimeError, "Procedure or method not implemented")
  119.     ELSIF rc = 100 THEN
  120.       Report (Line1, RunTimeError, "Failed to open shared library")
  121.     ELSIF rc > 20 THEN
  122.       strPtr := SYS.ADR (str);
  123.       E.base.OldRawDoFmtL ("Error code = %ld", rc, PutCh, strPtr);
  124.       Report (Line1, "Abnormal program exit", str);
  125.     END; (* ELSE *)
  126.   END; (* IF *)
  127. END ReportRC;
  128.  
  129.  
  130. BEGIN (* Errors *)
  131.   Report := DefaultReport;
  132.   Traps [0]  := SYS.ADR ("Trap #2 : Bus Error");
  133.   Traps [1]  := SYS.ADR ("Trap #3 : Address Error");
  134.   Traps [2]  := SYS.ADR ("Trap #4 : Illegal Instruction");
  135.   Traps [3]  := SYS.ADR ("Trap #5 : Divide by zero");
  136.   Traps [4]  := SYS.ADR ("Trap #6 : CHK instruction");
  137.   Traps [5]  := SYS.ADR ("Trap #7 : TRAPV instruction");
  138.   Traps [6]  := SYS.ADR ("Trap #8 : Privilege violation");
  139.   Traps [7]  := SYS.ADR ("Trap #9 : Trace bit trap");
  140.   Traps [8]  := SYS.ADR ("Trap #10 : Line 1010 emulator");
  141.   Traps [9]  := SYS.ADR ("Trap #11 : Line 1111 emulator");
  142.   Traps [10] := SYS.ADR ("Trap #32 : Compiler index check failed");
  143.   Traps [11] := SYS.ADR ("Trap #33 : Compiler type check failed");
  144.   Traps [12] := SYS.ADR ("Trap #34 : Compiler NIL check failed");
  145.   Traps [13] := SYS.ADR ("Trap #35 : Compiler case check failed");
  146.   Traps [14] := SYS.ADR ("Trap #36 : RETURN missing in function");
  147.   Traps [15] := SYS.ADR ("Trap #37 : Compiler stack check failed");
  148.   Traps [16] := SYS.ADR ("Trap #38 : Unspecified user trap");
  149.   Traps [17] := SYS.ADR ("Trap #39 : Unspecified user trap");
  150.   Traps [18] := SYS.ADR ("Trap #40 : Unspecified user trap");
  151.   Traps [19] := SYS.ADR ("Trap #41 : Unspecified user trap");
  152.   Traps [20] := SYS.ADR ("Trap #42 : Unspecified user trap");
  153.   Traps [21] := SYS.ADR ("Trap #43 : Unspecified user trap");
  154.   Traps [22] := SYS.ADR ("Trap #44 : Unspecified user trap");
  155.   Traps [23] := SYS.ADR ("Trap #45 : Unspecified user trap");
  156.   Traps [24] := SYS.ADR ("Trap #46 : Unspecified user trap");
  157.   Traps [25] := SYS.ADR ("Trap #47 : Unspecified user trap");
  158.   SYS.SETCLEANUP (ReportRC);
  159. END Errors.
  160.